perm filename FILLZ.F4[1,LCS] blob
sn#093917 filedate 1974-03-25 generic text, type T, neo UTF8
00100 IMPLICIT INTEGER(A-Z)
00200 COMMON D(2000),Q(100),R(100),E(100),NN
00300 DATA Q/24,50,0,24,24,42,8,24,24,32,16,24,88*0/
00400 1,R/30,0,0,30,24,4,4,24,16,8,8,16,88*0/
00450 1,E/-1,0,0,0,-1,0,0,0,-1,91*0/,TOT/12/
00500
00600 NN=0
01410 15 TYPE 151
01420 151 FORMAT(' TYPE COORDS.'/)
01430 152 FORMAT(60I)
01440 ACCEPT 152,(Q(K),K=1,60)
01450 ACCEPT 152,(R(K),K=1,60)
01625 ACCEPT 152,(E(K),K=1,60)
01635 ACCEPT 152,TOT
01640 400 DO 40 K=1,TOT
01650 J=2
01660 IF(E(K))J=3
01670 40 CALL LINES(Q(K),R(K),J)
01700 N=1
01800 4 JJ=0
01900 H=-1000
01950 Z=0
02000 DO 1 K=2,TOT
02100 IF(E(K).NE.0)GO TO 1
02150 A=R(K)
02160 B=R(K-1)
02165 IF(B.GT.A)GO TO 21
02170 C=A*1000+B
02175 GO TO 20
02180 21 C=B*1000+A
02190 20 IF(C.LE.Z)GO TO 1
02195 Z=C
02200 C FINDS HIGHEST LINE
02300 JJ=K
02400 H=R(JJ)
02500 1 CONTINUE
02600
02700 IF(JJ.EQ.0)GO TO 10
02800 J=JJ
02900 JA=J-1
03600 C J = END OF HIGHEST LINE
03700 19 RT=Q(J)
03800 LF=Q(JA)
04000 RJ=R(J)
04100 RJ1=R(JA)
04200 16 E(J)=-1
04300 C LINE USED
04400 HT=RJ-RJ1
04700 U=LF
04800 IF(RT.GT.U)GO TO 170
04810 LF=RT
04820 RT=U
04850 170 IF(RJ1.LT.RJ)RJ=RJ1
04860 DIS=RT-LF
04900
05000 17 DO 2 K=LF,RT
05100 D(N)=K
05200 Y=(HT*(K-U))/DIS+RJ
05300 D(N+1)=Y
05400 H=-1000
05500
05600 18 DO 3 I=2,TOT
05610 IF(E(I))GO TO 3
05655 C SKIP IF SAME LINE.
06100 QA=Q(I)
06200 QB=Q(I-1)
06300 IF((QA.GT.K.AND.QB.GT.K).OR.(QA.LT.K.AND.QB.LT.K))GOTO 3
06400 C LINE WAS NOT UNDER POINT K
06410 RA=R(I)
06420 RB=R(I-1)
06500 HX=RA-RB
06560 DX=IABS(QA-QB)
06575 IF(QA.GT.QB)QA=QB
06600 IF(RA.LT.RB)RA=RB
06900 B=(HX*(K-QA))/DX+RA
07210 IF(B.GT.Y)GO TO 3
07300 IF(B.LE.H)GO TO 3
07400 H=B
07500 IX=I
07600 C FOUND HIGHEST NEW POINT
07700 3 CONTINUE
07710 IF(H.EQ.Y)GO TO 2
08000 C WIPES OUT THIS LINE SEG.
08200 30 IF(K.NE.Q(IX).AND.K.NE.Q(IX-1))E(IX)=1
08250 C TOUCHING END OF SEG. DOES NOT COUNT.
08300
08310 IF(H.EQ.-1000)GO TO 2
08400 31 D(N+2)=H
08500 N=N+3
08600 2 CONTINUE
08700
08750 IF(D(N).EQ.-1000)GO TO 4
08800 D(N)=-1000
08900 C MARKS END OF ONE FILL SECTION
09000 N=N+1
09100 GO TO 4
09200
09350 10 N=N-1
09400 D(N)=-9999
09500 C MARKS FINAL END
09510 IO=5
09520 33 WRITE(IO,34)(D(K),K=1,N)
09530 34 FORMAT(9I6)
09600 N=1
09700 13 J=3
09800 C FOR INVIS. VECT.
09900 DX=D(N)
10000 12 CALL LINES(DX,D(N+1),J)
10100 J=2
10200 CALL LINES(DX,D(N+2),J)
10300 N=N+3
10400 DX=D(N)
10500 IF(DX.LE.-1000)GO TO 11
10600 CALL LINES(DX,D(N+2),J)
10700 CALL LINES(DX,D(N+1),J)
10800 N=N+3
10900 DX=D(N)
11000 IF(DX.GT.-1000)GO TO 12
11100
11200 11 IF(DX.EQ.-9999)GO TO 14
11300 N=N+1
11400 GO TO 13
11500 14 PAUSE
11600 GO TO 15
11700 END
11800
11900